perm filename CLEFS.F4[MSS,LCS]1 blob sn#106231 filedate 1974-06-13 generic text, type T, neo UTF8
00100	C****  CLEFS, JDRAW, CENTR, LINX, UNPACK, ROFF *********
00200		SUBROUTINE CLEFS
00400		DIMENSION JCLEF(11),MCLEF(600),RCMIN(4)
00600		COMMON /STF/RSTFAC(8),RSTJC /PLTR/IPLT,RHT,DIS
00700		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00800	      DATA RCMIN/3.3,10.5,7.0,10.5/
00900		EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7))
01000	     1 ,(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5))
01100		1,(RJI,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11))
01200		JE=MOD(JE,100)
01300	CC	JEZ=JE
01320		CALL NOZERO(RJF)
01346		IF(RJG.EQ.0)RJG=RJF
01372	C  IF P7 = 0, IT WILL EQUAL P6.
01400		IF(JA.NE.3)GO TO 9
01500		NAME='CLEF0'
01600		IF(JE.LT.10)GO TO 4
01700		RJF=RJF*.3
01800	C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
01900		RJG=RJG*.3
02000		GO TO 4
02100	9	IF(NAME.EQ.NJR)GO TO 4
02200		IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
02300		IF(NJR.EQ.0)GO TO 8	
02400	C  TO PICK UP BASIC DRAW NAME FROM P10 
02500		NAME=NJR
02600		GO TO 4
02700	8	TYPE 5
02800	CC	ACCEPT 6,NAME
02900	5	FORMAT(' SET P10=1'/)
03000	CC6	FORMAT(A5)
03200	C  LEADS TO PROPER FILE CALL
03300	4	NM=NAME+2*(JE/10)
03400	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
03500		JEZ=MOD(JE,10)+1
03600	CC	GO TO 2
03700	CC9	NM='CLFX'
03800	2	IF(NM.EQ.JNM)GO TO 30
03900	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
04000	C  JUMP IF ALREADY IN CORE
04100		IF(LOOKF(NM))GO TO 1111
04200		TYPE 1112,NM
04300		RETURN
04400	1112	FORMAT(1XA5,' -- NOT FOUND')
04500	1111	JNM=NM
04600	CC	CALL RDDATA(NM,JCLEF,MCLEF)
04700	CC	CALL IFILE(23,NM)
04800		CALL GETFI2(NM)
04900	CC	READ (23)JCLEF,K,(MCLEF(L),L=1,K)
05000		CALL FASTI2(JCLEF,11)
05100		CALL FASTI2(MCLEF,K)
05200	C  NEW DATA READER  6/74
05300	30	CALL CENTER(CENTR)
05400	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
05800	C  RJF IS SIZE FACTOR
05900		IF(JE.GT.3.OR.JA.NE.3)GO TO 811
06000	CC	IF(JEZ.EQ.0)JEZ=1
06050	C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
06100		IF(RJE.LT.100)GO TO 812
06200		RSTJC=.8*RSTJC
06300		CENTR=CENTR+RCMIN(JEZ)*RSTJC
06400	C  TO SET HGT. OF MINI CLEFS
06500	812	IF(JEZ.NE.4)GO TO 811
06600		CENTR=CENTR+RSTJC*14
06700		JEZ=3
06800	C   ABOVE IS NOW AT TOP
06900	811	L=JCLEF(JEZ)
07000		IF(JI.NE.0)CALL ROTATE(MCLEF,L)
07100	C  RJI=P9=DEGREES OF ROTATION (0-360)
07200		CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
07300	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
07400	C			JH=-2 OMITS FILLER DURING PLOT
07500	
07600	CC	N=0
07700	CC	JD=MCLEF(L)+L
07800	CC	IF(MCLEF(JD).EQ.999)N=JD+1
07900	CC1	IF(N.NE.0.AND.JH.NE.-2.AND.(IPLT.OR.JH))CALL OLDFIL(MCLEF(N),
08000	CC	1 RJB,CENTR,RJF,RJG)
08100		IF((JH.EQ.-2.AND.IPLT).OR.(JH.NE.-1.AND.IPLT.GE.0))RETURN
08200		DO 3 K=L+1,MCLEF(L)+L
08300		IF(MCLEF(K).LT.200000000)GO TO 3
08400		JD=MCLEF(L)-1
08500		IF(K.GT.L+1)JD=JD-K+L+1
08600		CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
08700		RETURN
08800	3	CONTINUE
08900	C  FILLS ONLY WHEN PLOTING OR RJG=-1
09000		END
09100	
09200		SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
09300		COMMON/LL/LL
09400		DIMENSION M(1)
09500		RC=RX*RSTJC
09600		RD=RY*RSTJC
09700		DO 2 K=2,M(1)
09800		CALL UNPACK(IA,IB,M(K))
09900	CC	RA=IA*RC+RJB
10000	CC	RB=IB*RD+CENTR
10100	CC	IF(K.EQ.I)LL=3
10200	CC2	CALL LINES(RA,RB,LL)
10300	2	CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
10400		END
10500	
10600		SUBROUTINE CENTER(CNTR)
10700	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
10800		COMMON /STF/RSTFAC(8),RSTJC
10900		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
11000		COMMON/POSI/STF(8),JJB,POS
11100		EQUIVALENCE (RJD,RJQ(2))
11200		CNTR=POS+(2+AMOD(RJD,100.)*7)*RSTJC
11300		END
11400	
11500		SUBROUTINE LINX(A,B,C,D)
11600	C  SAVES SPACE FOR SINGLE LINES.
11700		CALL LINES(A,B,3)
11800		CALL LINES(C,D,2)
11900		END
12000	
12100		SUBROUTINE UNPACK(M,N,I)
12200		COMMON/LL/L
12300	C  L IS FOR VIS. OR INVIS. LINES.
12400		N=I
12500		L=2
12600		M=N/100000000
12700		IF(M.EQ.0)GO TO 2
12800		L=3
12900		N=N-100000000*M
13000	2	M=N/10000
13100	CC	N=N-M*10000
13200		N=MOD(N,10000)
13300		IF(M.GT.1000)M=1000-M
13400		IF(N.GT.1000)N=1000-N
13500		END
13600	
13700		FUNCTION ROFF(R)
13800		S=.5
13900		IF(R)S=-S
14000		ROFF=R+S
14100		RETURN
14200		END